home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / ptv1n1.arc / PCTV1N1.ARC / UNEWTYPE.PAS < prev   
Pascal/Delphi Source File  |  1990-06-08  |  2KB  |  71 lines
  1. (*
  2. **    File:    unewtype.pas
  3. **    Purpose: Add new data type to FORMS unit
  4. **    Author:  (c) 1989 by Tom Swan. All rights reserved.
  5. *)
  6.  
  7. unit UNewType;
  8.  
  9. interface
  10.  
  11. uses Forms, Sliders;
  12.  
  13. type
  14.  
  15.    FYesNoPtr = ^FYesNo;
  16.    FYesNo = object( FText )
  17.       constructor init( px, py : Integer; ptitle : FString );
  18.       procedure getStr( var s : FString ); virtual;
  19.       function putStr( var s : FString ) : Boolean; virtual;
  20.    end; { FYesNo }
  21.  
  22.    FStream = object( Sliders.FStream )
  23.       procedure registerTypes; virtual;
  24.    end; { FStream }
  25.  
  26.  
  27. implementation
  28.  
  29.  
  30. {---- Construct and initialize a new FYesNo object }
  31.  
  32. constructor FYesNo.init( px, py : Integer; ptitle : FString );
  33. begin
  34.    FText.init( px, py, sizeof( Boolean ), ptitle, 3 );
  35. end; { init }
  36.  
  37.  
  38. {---- Return a string (s) that represents the current
  39. value of the FYesNo object. }
  40.  
  41. procedure FYesNo.getStr( var s : FString );
  42. begin
  43.    if Boolean( value^ )
  44.       then s := 'Yes'
  45.       else s := 'No '
  46. end; { GetStr }
  47.  
  48.  
  49. {---- Change current FYesNo object value according to
  50. whether the input string (s) begins with 'Y' or 'N'. }
  51.  
  52. function FYesNo.putStr( var s : FString ) : Boolean;
  53. begin
  54.    if length( s ) > 0
  55.       then Boolean( value^ ) := upcase( s[1] ) = 'Y'
  56.       else Boolean( value^ ) := FALSE;
  57.    PutStr := TRUE
  58. end; { putStr }
  59.  
  60.  
  61. {---- Register all data types plus the new FYesNo
  62. object with the Objects unit Stream manager. }
  63.  
  64. procedure FStream.registerTypes;
  65. begin
  66.    Sliders.FStream.registerTypes;
  67.    Register( typeof( FYesNo ), @FYesNo.store, @FYesNo.load );
  68. end; { registerTypes }
  69.  
  70. end. { UNewType }
  71.